home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / srefv112.zip / SREFPRC1.ZIP / DOCGI.SRF < prev    next >
Text File  |  1996-05-16  |  12KB  |  280 lines
  1. /* This is don meyers cgi handler, modified for SRE-FILTER */
  2. /* ----------------------------------------------------------------------- */
  3. /* DoCGI: Handle branching of CGI scripts / subroutines.            */
  4. /* ----------------------------------------------------------------------- */
  5. sref_DoCGI:
  6.  
  7. parse arg cgi_bin_dir, sel, verb, clientname0, filter_name, port , ,
  8.         servername, protocol, dir, who,tempfile,cmdfile
  9.  
  10. /* 
  11. 1) cgi_bin_dir is of form d:\goserv\progs (dir where progs located --
  12.   strip final \).  Should be set by configurator.
  13.     Note: cgi-bin\mapimage request strings are captured by SRE-FILTER, and not processed here
  14.  
  15. 2) Sel is parsed, with scriptname, pathparms and list removed:
  16.     i.e.; if sel = cgi-bin/turkey/joe/proj1?arg1=wow
  17.  
  18.   scriptname= turkey  
  19.       This will run  cgi_bin_dir\turkey (a cmd or exe file).
  20.        If you want to run programs NOT in the cgi_bin_dir directory,
  21.  
  22.   pathparms= joe/proj
  23.   list= arg1=wow
  24.  
  25. 3) Other variables are generic variables set in sre-filter
  26.  
  27. */
  28.  
  29.  
  30. parse var sel  t1 '?' list
  31.  
  32.  
  33.  
  34. foo1=translate(sel,'/','\')
  35. parse var t1 foocgi '/' scriptname '/' pathparms
  36. if pathparms<>"" then pathparms=strip(pathparms,'t','/')
  37.  
  38. scriptname=strip(scriptname); cgi_bin_dir=strip(cgi_bin_dir)
  39.  
  40. say " CGI-Bin call for " scriptname  
  41. /* begin  meyer stuff */
  42.   scriptalias=cgi_bin_dir
  43.   env='OS2ENVIRONMENT'
  44. tempfile=translate(tempfile,'\','/')
  45.  
  46.  
  47.   if (verb == 'POST') then do
  48.          'read body var postedlist'                    /* get the incoming data */
  49.          if rc=-4 then                            /* body too large */
  50.            return response_dc('badreq', 'sent too much data')
  51.          if rc<>0 then                            /* e.g., invalid HTTP header */
  52.            return response_dc('badreq', 'sent data that could not be read')
  53.   end
  54.  
  55.   ScriptName = translate(ScriptName)
  56.  
  57. /* we could check by extenstion (com, cmd, exe), but this might cause incorrect errors
  58.    So, we'll risk ugly errors below */
  59.  
  60.   aa=sysfiletree(scriptalias'\'scriptname,'yow1','F')
  61.   if yow1.1 =0  then
  62.        return response_dc( 'notfound', 'cannot be honored.  <p>This server does not currently support any CGI service called "'ScriptName'".')
  63.   
  64.  
  65. /* else, do the script */
  66.    parse var ScriptAlias Drive':'Rest
  67.    if (Drive == ScriptAlias) then Drive = ''  /* means no drive info to parse off... */
  68.      i = 1
  69.     _acc = REQFIELD("accept")
  70.      acc = '%'
  71.     ClientAccepts = ''
  72.     do while (acc \= _acc)
  73.                acc = REQFIELD("accept", i)
  74.                if (ClientAccepts \= '') then ClientAccepts = ClientAccepts','acc
  75.                else ClientAccepts = acc
  76.                i = i+1
  77.    end
  78.  
  79.    rc = 0
  80.  
  81.    name=0 then
  82.          name = ClientName()
  83.  
  84.   rc = stream(tempfile, 'c', 'close')   /* Close the file to avoid preventing process from access. */
  85.  
  86. /* This is pretty touchy stuff below, be very careful if you edit any of this... */
  87.     InputFile = translate( tempfile, '#', '$')
  88.     ReturnCode = '200'        /* default return code  */
  89.     call lineout CmdFile, "/**/"
  90.     call lineout CmdFile, "'@ECHO OFF'"
  91.     if (Drive \= '') then call lineout CmdFile, "'"Drive":'"
  92.     call lineout CmdFile, "'CD "ScriptAlias"'"
  93.     call lineout CmdFile, "env  = '"env"'"
  94.  
  95.    SrvVersionText = server('H')||' '||filter_name
  96.    rc = value('SERVER_SOFTWARE', SrvVersionText, env)
  97.    rc = value('GATEWAY_INTERFACE','CGI/1.1',env)
  98.    rc = value('SERVER_NAME',ServerName,env)
  99.    rc = value('SERVER_PORT',port,env)
  100.  
  101.    i =1
  102.    l =1
  103.    ClientAccepts = ''
  104.  
  105.    HeaderFile = translate( tempfile, '~', '$')
  106.    'READ HEADER FILE NAME 'HeaderFile                    /* get the incoming header data */
  107.     hd = linein( HeaderFile, 1)
  108.     do while (hd \= '')
  109.          hd = linein( HeaderFile)
  110.          parse var hd Hkey': 'content
  111.          Hkey = translate(Hkey, '_', '-')
  112.          Hkey = translate(Hkey)
  113.          select
  114.              when (Hkey == 'ACCEPT') then do
  115.                     parse var content content'; 'q
  116.                     if (i > 1) then ClientAccepts = ClientAccepts', 'content
  117.                     else ClientAccepts = content
  118.                     if (l == 5) then do
  119.                        call lineout CmdFile, "'SET HTTP_ACCEPT=%HTTP_ACCEPT%"ClientAccepts"'"
  120.                        ClientAccepts = ''
  121.                        l = 1
  122.                     end
  123.                     l = l+1
  124.                     i = i+1
  125.              end   /* accept */
  126.  
  127. /* Handle other, unrecognized headers to conform to CGI/1.1 spec.  */
  128.               otherwise do
  129.                      if (Hkey \= '') then rc = lineout(CmdFile, "rc = value('HTTP_"Hkey"','"content"',env)")
  130.               end
  131.           end     /*select */
  132.     end
  133.  
  134.     rc = lineout( HeaderFile)
  135.     if (ClientAccepts \= '') then call lineout CmdFile, "'SET HTTP_ACCEPT=%HTTP_ACCEPT%"ClientAccepts"'"
  136.  
  137.     crlf = '0d0a'x
  138.     output_text =     "rc = value('SCRIPT_NAME','"ScriptName"',env)"crlf,
  139.     "rc = value('REQUEST_METHOD','"verb"',env)"crlf,
  140.     "rc = value('REMOTE_ADDR','"who"',env)"crlf,
  141.     "rc = value('SERVER_PROTOCOL','"protocol"',env)"crlf,
  142.     "rc = value('PATH_INFO','/"PathParms"',env)"crlf,
  143.     "rc = value('PATH_TRANSLATED','"dir||PathParms"',env)"crlf,
  144.      "rc = value('REMOTE_USER','"REQFIELD("from")"',env)"crlf,
  145.      "rc = value('AUTH_TYPE','"REQFIELD("auth-type")"',env)"crlf,
  146.      "rc = value('CONTENT_TYPE','"REQFIELD("Content-type")"',env)"crlf,
  147.      "rc = value('CONTENT_LENGTH','"REQFIELD("Content-length")"',env)"crlf,
  148.      "rc = value('REMOTE_HOST','"name"',env)"crlf,
  149.      "rc = value('QUERY_STRING','"list"',env)"
  150.  
  151.     call lineout CmdFile, output_text
  152.  
  153.     /* Change suggested by someone (lost the email) to allow 4OS2 to be used as shell.   */
  154.      ScriptAlias = translate( ScriptAlias, '\', '/')
  155.  
  156.      plist=packur(list)                /* pack escape sequences in list */
  157.  
  158.      if (plist \= '') then
  159.                if (pos('&', plist) > 0) | (pos('=', plist) > 0) | (pos("'", plist) > 0) then 
  160.                  /* plist = '"'plist'"'      / *  This line "quotes" the parameter list.  Actual HTTPDs  */ 
  161.                   plist = ''        /*  simply omit the parameter list in this case.        */
  162.  
  163.                else do            /* Process the parameter list back to original ascii format */
  164.                   plist = translate( plist, ' ', '+')
  165.                end
  166.  
  167.      if (verb == 'POST') then do 
  168.                rc = charout( InputFile, postedlist, 1)
  169.                rc = stream( InputFile, 'C', 'close')        /* Close file */
  170.                call lineout CmdFile, "'CALL "ScriptAlias"\"ScriptName" "plist" <"InputFile" >>"tempfile"'"
  171.             end
  172.      else do 
  173.                call lineout CmdFile, "'CALL "ScriptAlias"\"ScriptName" "plist" >>"tempfile"'"
  174.      end
  175.  
  176.      call lineout CmdFile        /* Close file */
  177.      do 
  178.           address cmd
  179.           CmdFile
  180.           rcode=RC
  181.           address
  182.           if (rcode == 0) then do
  183.              Hder = '%'
  184.              ContentType = 'text/html'
  185.              ContentLength = 0
  186.              do while (Hder \= '')
  187.                 Hder = linein( tempfile) 
  188.                 if hder="" then iterate
  189.  
  190.                 parse var Hder Hkey': 'content
  191.                 _Hkey = Hkey
  192.                 _Hkey = translate( _Hkey)
  193.  
  194. /* This should handle the special header case of nph-* scripts... */
  195.                 if (word(_Hkey,1) == 'HTTP/1.0') then do
  196.                         parse var Hder Hkey content
  197.                         _Hkey = 'STATUS'
  198.                       'HEADER NOAUTO'
  199.                  end
  200.  
  201.                  select
  202.                         when (_Hkey == 'CONTENT-LENGTH') then ContentLength = content
  203.                         when (_Hkey == 'CONTENT-TYPE') then ContentType = content
  204.                         when (_Hkey == 'LOCATION') | (_Hkey == 'URI') then do
  205. /*  It is not 'spec' to assume a redirect if URI is included, but 'LOCATION' isn't really even 'spec'... */
  206.                            if (_Hkey == 'LOCATION') then do
  207.                               ReturnCode = '302'
  208.                              'RESPONSE HTTP/1.0 'ReturnCode' Found'     /* Set HTTP response line */
  209.                            end
  210.                           'HEADER ADD 'Hkey': 'content
  211.                         end
  212.                         when (_Hkey == 'STATUS') then do
  213.                            parse var content ReturnCode rest
  214.                            'RESPONSE HTTP/1.0 'content     /* Set HTTP response line */
  215.                         end
  216.                         otherwise 'HEADER ADD 'Hkey': 'content /* oo */
  217.                     end
  218.                  end
  219.                  _ContentLength = Chars(tempfile)
  220.                  if ( _ContentLength < ContentLength) | (ContentLength == 0) then ContentLength = _ContentLength
  221.  
  222.                  'HEADER ADD Content-length: ' ContentLength
  223.                   Content = charin( tempfile,, ContentLength)
  224.                   Call Lineout tempfile            /* Close file before delete */
  225.                end              /* rcode=0 */
  226.  
  227.                rc = SysFileDelete( tempfile)        /* delete tempfile because we're shortening it.  */
  228.                rc = SysFileDelete( CmdFile)           /* delete CmdFile, we're done with it.  */
  229.                if (verb == 'POST') then rc = SysFileDelete( InputFile)    /* delete InputFile, we're done with it.  */
  230.                rc = SysFileDelete( HeaderFile)    /* delete HeaderFile, we're done with it.  */
  231.  
  232.                if (rcode \= 0) then return response_dc('badreq', 'could not be completed.<p><pre>    Form Error: 'rcode'</pre>')
  233.  
  234.                rc = charout( tempfile, Content, 1)    /* Write contents back to tempfile  */
  235.  
  236.                rc = stream( tempfile, 'c', 'close')
  237.                'FILE ERASE TYPE 'ContentType' NAME' tempfile
  238.                return ''  
  239.            end          /* rcode=0 */
  240.    end
  241.  
  242.    return response_dc('badreq', 'problem with CGI script "'scriptname'".')
  243.  
  244.  
  245. /* ----------------------------------------------------------------------- */
  246. /* RESPONSE_dc: Standard [mostly error] responses.                            */
  247. /* ----------------------------------------------------------------------- */
  248. /* This routine should stay in the main filter program.                    */
  249. /* Arguments are: response type and extended message information.          */
  250. /* It returns the GoServe command to handle the result file.               */
  251. response_dc: procedure expose tempfile  seloriginal request0 source0
  252.   parse arg request, message
  253.   select
  254.     when request='badreq'   then use='400 Bad request syntax'
  255.     when request='notfound' then use='404 Not found'
  256.     when request='forbid'   then use='403 Forbidden'
  257.     when request='unauth'   then use='401 Unauthorized'
  258.     otherwise do
  259.         use='404 Not found'
  260.         say 'weird response ' request message
  261.       end
  262.     end  /* Add others to this list as needed */
  263.  
  264.  
  265.   /* Now set the response and build the response file */
  266.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  267.   parse var use code text
  268.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  269.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  270.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  271.   call lineout tempfile, "<p>The request from your Web client" message"."
  272.   call lineout tempfile, "<hr><em>HTTP response code:</em>" code '['text']'
  273.   call lineout tempfile, "<br><em>From server at:</em>" servername()
  274.   call lineout tempfile, "<br><em>Running:</em>" server()
  275.   call lineout tempfile, "</body></html>"
  276.   call lineout tempfile  /* close */
  277.   return 'FILE ERASE TYPE text/html NAME' tempfile
  278.  
  279.  
  280.